home *** CD-ROM | disk | FTP | other *** search
/ ASME's Mechanical Engine…ing Toolkit 1997 December / ASME's Mechanical Engineering Toolkit 1997 December.iso / auto_cad / dleaders.exe / DLEADERS.LSP < prev    next >
Lisp/Scheme  |  1994-12-30  |  9KB  |  263 lines
  1. ;*************************************************************************
  2. ;
  3. ;  DLEADERS.LSP          Copyright (c) 1994 - DesignTec
  4. ;  Version 1.2                               255 Celia St.
  5. ;                                            Boaz, AL 35957
  6. ;                                            (205) 593-7789
  7. ;
  8. ;  LAST REVISION:  12-28-94
  9. ;
  10. ;
  11. ;  THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESSED OR IMPLIED
  12. ;  WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  13. ;  PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  14. ;
  15. ;*************************************************************************
  16. ;
  17. ;  DESCRIPTION
  18. ;
  19. ;  A user friendly dialog box based set of utilities to draw leader tags
  20. ;  with user definable text boxes and arrows.
  21. ;
  22. ;*************************************************************************
  23. ;
  24. ;  ACCOMPANYMENTS
  25. ;
  26. ;  The following slide files should be located in a directory that is in
  27. ;  the standard Autocad search path:
  28. ;
  29. ;  DLEADERS.SLB
  30. ;
  31. ;  The following blocks should be located in a directory that is in the
  32. ;  standard Autocad search path:
  33. ;
  34. ;  DLEADERS.DWG
  35. ;
  36. ;  The following dialog control language (*.DCL) file should be located in
  37. ;  a directory that is in the standard Autocad search path:
  38. ;                
  39. ;  DLEADERS.DCL
  40. ;
  41. ;*************************************************************************
  42. ;;
  43. ;;      SETUP ROUTINE
  44. ;;
  45. (defun C:DL_SETUP ( / ARROW_T TXTBOX_T DIRECT_T)
  46.   (alert "\n    DLEADERS Version 1.2\nUNREGISTERED EVALUATION COPY\n      Please Register!")
  47.   (alert "\nDesignTec\n255 Celia St.\nBoaz, Alabama 35957\n205 593-7789")
  48.   (dl_init_stuf)
  49.   (setq DCL_ID (load_dialog "DLEADERS.DCL"))
  50.   (if (not (new_dialog "DLEADERS" DCL_ID)) (exit))
  51.   (dl_tile_setup)
  52.   (dl_get_actions)
  53.   (start_dialog)
  54.   (unload_dialog DCL_ID)
  55.   (princ)
  56. )
  57. ;;
  58. ;;
  59. (defun dl_init_stuf ()
  60.   (setq what_next 5)
  61.   (if (= (tblsearch "block" "dleaders") nil)
  62.     (command "insert" "dleaders" "0,0" "" "" "")
  63.   )
  64.   (if (= ARROW nil) (setq ARROW "ar_none") (setq ARROW_T ARROW))
  65.   (if (= TXTBOX nil) (setq TXTBOX "tx_none") (setq TXTBOX_T TXTBOX))
  66.   (if (= DIRECT nil) (setq DIRECT "from_feat") (setq DIRECT_T DIRECT))
  67. ;  (setq AR_SIZE_T AR_SIZE)
  68. ;  (setq TX_SIZE_T TX_SIZE)
  69. )
  70. ;;
  71. ;;
  72. (defun dl_tile_setup ()
  73.   (set_tile "arrow" ARROW)
  74.   (set_tile "text_box" TXTBOX)
  75.   (set_tile "direction" DIRECT)
  76.   (setq X (dimx_tile "image"))
  77.   (setq Y (dimy_tile "image"))
  78.  
  79.   (dl_show_slide)
  80. ;  (set_tile "ar_size" AR_SIZE)
  81. ;  (set_tile "tx_size" TX_SIZE)
  82. )
  83. ;;
  84. ;;
  85. (defun dl_get_actions ()
  86.   (action_tile "arrow" "(setq ARROW $value) (dl_show_slide)")
  87.   (action_tile "text_box" "(setq TXTBOX $value) (dl_show_slide)")
  88.   (action_tile "direction" "(setq DIRECT $value) (dl_show_slide)")
  89. ;  (action_tile "ar_size" "(setq AR_SIZE $value) (dl_show_slide)")
  90. ;  (action_tile "tx_size" "(setq TX_SIZE $value) (dl_show_slide)")
  91.   (action_tile "cancel" "(leader_abort)")
  92. )         
  93. ;;
  94. ;;
  95. (defun leader_abort ()
  96.   (setq ARROW ARROW_T)
  97.   (setq TXTBOX TXTBOX_T)
  98.   (setq DIRECT DIRECT_T)
  99. ;  (setq AR_SIZE AR_SIZE_T)
  100. ;  (setq TX_SIZE TX_SIZE_T)
  101.   (exit)
  102.   (princ)
  103. )
  104. ;;
  105. ;;
  106. (defun dl_show_slide ( / AR TX DR)
  107.   (cond
  108.     ((= ARROW "ar_none") (setq AR "0_"))
  109.     ((= ARROW "ar_tic") (setq AR "1_"))
  110.     ((= ARROW "ar_arc1") (setq AR "2_"))
  111.     ((= ARROW "ar_arc2") (setq AR "3_"))
  112.     ((= ARROW "ar_mech") (setq AR "4_"))
  113.     ((= ARROW "ar_dot") (setq AR "5_"))
  114.   )
  115.   (cond
  116.     ((= TXTBOX "tx_none") (setq TX "0_"))
  117.     ((= TXTBOX "tx_circ") (setq TX "1_"))
  118.     ((= TXTBOX "tx_sqar") (setq TX "2_"))
  119.     ((= TXTBOX "tx_dmnd") (setq TX "3_"))
  120.     ((= TXTBOX "tx_hex") (setq TX "4_"))
  121.     ((= TXTBOX "tx_elps") (setq TX "5_"))
  122.   )
  123.   (cond
  124.     ((= DIRECT "from_feat") (setq DR "1"))
  125.     ((= DIRECT "from_txt") (setq DR "2"))
  126.   )
  127.   (setq SLIDE (strcat "DLEADERS(" AR TX DR ")"))
  128.   (start_image "image")
  129.   (fill_image 0 0 X Y -2)
  130.   (slide_image 0 0 X Y SLIDE)
  131.   (end_image)
  132. )
  133. ;;
  134. ;;      MAIN ROUTINE
  135. ;;
  136. (defun C:DLD ( / ORX SNX SZE RAD PA PB PC MRK NONE)
  137.   (cond
  138.     ((= ARROW nil) (C:DL_SETUP))
  139.     ((= TXTBOX nil) (C:DL_SETUP))
  140.     ((= DIRECT nil) (C:DL_SETUP))
  141.   )
  142.   (if (= DIRECT "from_feat")
  143.   
  144.     (progn  (setvar "cmdecho" 0)
  145.             (setq ORX (getvar "orthomode"))
  146.             (setq SNX (getvar "snapmode"))
  147.             (setq SZE (getvar "TEXTSIZE"))
  148.             (setq RAD (+ SZE (/ SZE 4.0)))
  149.             (setvar "snapmode" 0)
  150.             (setvar "orthomode" 0)
  151.             (setq PA (getpoint "\nStart of Leader < at Feature > : "))
  152.             (setq PB (getpoint PA "\nEnd of Leader Leg : "))
  153.             (command "line" PA PB "")
  154.             (setvar "orthomode" 1)
  155.             (setq PC (getpoint PB "\nEnd of Leader < at Text Location > : "))
  156.             (command "line" PB PC "")
  157.             (setq MRK (getstring "\nEnter Text < two characters only > : "))
  158.             (cond
  159.               ((= ARROW "ar_none") (setq NONE 1))
  160.               ((= ARROW "ar_tic") (command "insert" "ar_tic" PA SZE SZE PB))
  161.               ((= ARROW "ar_arc1") (command "insert" "ar_arc1" PA SZE SZE PB))
  162.               ((= ARROW "ar_arc2") (command "insert" "ar_arc2" PA SZE SZE PB))
  163.               ((= ARROW "ar_mech") (command "insert" "ar_mech" PA SZE SZE PB))
  164.               ((= ARROW "ar_dot") (command "insert" "ar_dot" PA SZE SZE PB))
  165.             )   
  166.             (cond 
  167.               ((= TXTBOX "tx_none") (draw_tx_none))
  168.               ((= TXTBOX "tx_circ") (draw_tx_circ))
  169.               ((= TXTBOX "tx_sqar") (draw_tx_sqar))
  170.               ((= TXTBOX "tx_dmnd") (draw_tx_dmnd))
  171.               ((= TXTBOX "tx_hex") (draw_tx_hex))
  172.               ((= TXTBOX "tx_elps") (draw_tx_elps))
  173.             )
  174.             (command "text" "m" PC "" "0" MRK)
  175.             (setvar "snapmode" SNX)
  176.             (setvar "orthomode" ORX)
  177.     )       
  178.     (progn  (setvar "cmdecho" 0)
  179.             (setq ORX (getvar "orthomode"))
  180.             (setq SNX (getvar "snapmode"))
  181.             (setq SZE (getvar "TEXTSIZE"))
  182.             (setq RAD (+ SZE (/ SZE 4.0)))
  183.             (setvar "snapmode" 0)
  184.             (setvar "orthomode" 1)
  185.             (setq PC (getpoint "\nStart of Leader < at Text Location > : "))
  186.             (setq PB (getpoint PC "\nEnd of Leader Leg : "))
  187.             (command "line" PC PB "")
  188.             (setvar "orthomode" 0)
  189.             (setq PA (getpoint PB "\n End of Leader < at Feature > : "))
  190.             (command "line" PB PA "")
  191.             (setq MRK (getstring "\nEnter Text < two characters only > : "))
  192.             (cond
  193.               ((= ARROW "ar_none") (setq NONE 1))
  194.               ((= ARROW "ar_tic") (command "insert" "ar_tic" PA SZE SZE PB))
  195.               ((= ARROW "ar_arc1") (command "insert" "ar_arc1" PA SZE SZE PB))
  196.               ((= ARROW "ar_arc2") (command "insert" "ar_arc2" PA SZE SZE PB))
  197.               ((= ARROW "ar_mech") (command "insert" "ar_mech" PA SZE SZE PB))
  198.               ((= ARROW "ar_dot") (command "insert" "ar_dot" PA SZE SZE PB))
  199.             )            
  200.             (cond 
  201.               ((= TXTBOX "tx_none") (draw_tx_none))
  202.               ((= TXTBOX "tx_circ") (draw_tx_circ))
  203.               ((= TXTBOX "tx_sqar") (draw_tx_sqar))
  204.               ((= TXTBOX "tx_dmnd") (draw_tx_dmnd))
  205.               ((= TXTBOX "tx_hex") (draw_tx_hex))
  206.               ((= TXTBOX "tx_elps") (draw_tx_elps))
  207.             )
  208.             (command "text" "m" PC "" "0" MRK)
  209.             (setvar "snapmode" SNX)
  210.             (setvar "orthomode" ORX)
  211.     )
  212.   )
  213.   (princ)
  214. )
  215. ;;
  216. ;;      END MAIN ROUTINE
  217. ;;
  218. (defun  draw_tx_none ()
  219.   (command "circle" PC RAD)
  220.   (command "trim" "l" "" PC "")
  221.   (command "erase" "l" "")
  222. )    
  223. ;;
  224. ;;
  225. (defun draw_tx_circ ()
  226.   (command "circle" PC RAD)
  227.   (command "trim" "l" "" PC "")
  228. )
  229. ;;
  230. ;;
  231. (defun draw_tx_sqar ()
  232.   (command "polygon" "4" PC "C" RAD)
  233.   (command "trim" "l" "" PC "")
  234. )
  235. ;;
  236. ;;
  237. (defun draw_tx_dmnd ()
  238.   (command "polygon" "4" PC "c" RAD)
  239.   (command "rotate" "l" "" PC "45")
  240.   (command "trim" "l" "" PC "")
  241. )
  242. ;;
  243. ;;
  244. (defun draw_tx_hex ()
  245.   (command "polygon" "6" PC "c" RAD)
  246.   (command "trim" "l" "" PC "")
  247. )
  248. ;;
  249. ;;
  250. (defun draw_tx_elps ( / EX EY EX1 EX2 EPNT1 EPNT2)
  251.   (setq EX (car PC))
  252.   (setq EY (car (cdr PC)))
  253.   (setq EX1 (- EX (* SZE 1.5)))
  254.   (setq EX2 (+ EX (* SZE 1.5)))
  255.   (setq EPNT1 (list EX1 EY))
  256.   (setq EPNT2 (list EX2 EY))
  257.   (command "ellipse" EPNT1 EPNT2 SZE)
  258.   (command "trim" "l" "" PC "")
  259. )
  260. ;;
  261. ;;
  262.  
  263.